home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / program / ctlib100.zip / INSTALL.LZH / COLLECT1.PAS < prev    next >
Pascal/Delphi Source File  |  1996-10-12  |  4KB  |  146 lines
  1. {**************************************************************************}
  2. {*  BitSoft Development, L.L.C.                                           *}
  3. {*  Copyright (C) 1995, 1996 BitSoft Development, L.L.C.                  *}
  4. {*  All rights reserved.                                                  *}
  5. {*  Containers Library demo                                               *}
  6. {**************************************************************************}
  7.  
  8. program Collect1;
  9.  
  10. {$X+}
  11.  
  12. { Sample program for using a huge collection. }
  13.  
  14. uses Objects, Containr, ctCollec,
  15.      {$ifdef Windows}
  16.      WinCtr;
  17.      {$else}
  18.      Crt;
  19.      {$endif}
  20.  
  21. type
  22.   PContact = ^TContact;
  23.   TContact = object (TObject)
  24.       FirstName,
  25.       LastName,
  26.       Phone,
  27.       Company : PString;
  28.     constructor Init(ALastName, AFirstName, APhone, ACompany : string);
  29.     destructor Done; virtual;
  30.   end; { TContact }
  31.  
  32. constructor TContact.Init(ALastName, AFirstName, APhone, ACompany : string);
  33. begin
  34.   FirstName := NewStr(AFirstName);
  35.   LastName := NewStr(ALastName);
  36.   Phone := NewStr(APhone);
  37.   Company := NewStr(ACompany);
  38. end;
  39.  
  40. destructor TContact.Done;
  41. begin
  42.   DisposeStr(FirstName);
  43.   DisposeStr(LastName);
  44.   DisposeStr(Phone);
  45.   DisposeStr(Company);
  46. end;
  47.  
  48. procedure DisplayContacts(ContactList : PSequence);
  49.  
  50.   procedure PrintInfo (Item : Pointer); far;
  51.   begin
  52.     with PContact(Item)^ do
  53.       writeln(LastName^, '':15 - Length(LastName^),
  54.         FirstName^, '':15 - Length(FirstName^),
  55.         Phone^, '':20 - Length(Phone^),
  56.         Company^, '':20 - Length(Company^));
  57.   end;
  58.  
  59. begin
  60.   ContactList^.ForEach(@PrintInfo);
  61. end;
  62.  
  63. procedure DisplayFirst(ContactList : PSequence);
  64. var
  65.   Item : Pointer;
  66.   Index : LongInt;
  67. begin
  68.   Item := ContactList^.First(Index);
  69.   Writeln('First item:');
  70.   with PContact(Item)^ do
  71.     writeln(LastName^, '':15 - Length(LastName^),
  72.       FirstName^, '':15 - Length(FirstName^),
  73.       Phone^, '':20 - Length(Phone^),
  74.       Company^, '':20 - Length(Company^));
  75.   ContactList^.DoneItem(Item); { not required }
  76. end;
  77.  
  78. procedure DisplayLast(ContactList : PSequence);
  79. var
  80.   Item : Pointer;
  81.   Index : LongInt;
  82. begin
  83.   Item := ContactList^.Last(Index);
  84.   Writeln('Last item:');
  85.   with PContact(Item)^ do
  86.     writeln(LastName^, '':15 - Length(LastName^),
  87.       FirstName^, '':15 - Length(FirstName^),
  88.       Phone^, '':20 - Length(Phone^),
  89.       Company^, '':20 - Length(Company^));
  90.   ContactList^.DoneItem(Item); { not required }
  91. end;
  92.  
  93. procedure FindLastName(ContactList : PSequence; LastName : string);
  94. var
  95.   Item : Pointer;
  96.   Index : LongInt;
  97.  
  98.   function MatchLastName (Item : Pointer): boolean; far;
  99.   begin
  100.     MatchLastName := (LastName = PContact(Item)^.LastName^);
  101.   end;
  102.  
  103. begin
  104.   Item := ContactList^.FirstThat(@MatchLastName, Index);
  105.   Writeln('Item found with last name ''', LastName, ''':');
  106.   with PContact(Item)^ do
  107.     writeln(LastName^, '':15 - Length(LastName^),
  108.       FirstName^, '':15 - Length(FirstName^),
  109.       Phone^, '':20 - Length(Phone^),
  110.       Company^, '':20 - Length(Company^));
  111.   ContactList^.DoneItem(Item); { not required }
  112. end;
  113.  
  114. var
  115.   ContactInfo : PHugeCollection;
  116.  
  117. begin
  118.   ClrScr;
  119.  
  120.   { Create the collection }
  121.   ContactInfo := New(PHugeCollection, Init(50, 10));
  122.  
  123.   { Insert items into the collection }
  124.   with ContactInfo^ do
  125.   begin
  126.     Insert(New(PContact, Init('Lewis', 'Carl', '(506) 83-780',
  127.       'Running, Corp.')));
  128.     Insert(New(PContact, Init('Benton', 'Michael', '(403) 33-973',
  129.       'ER, Inc.')));
  130.     Insert(New(PContact, Init('Wagner', 'Robert', '(906) 11-230',
  131.       'Symphony, Ltd.')));
  132.     Insert(New(PContact, Init('Smith', 'John', '(656) 75-843',
  133.       'InterComm, Corp.')));
  134.   end; { with }
  135.  
  136.   DisplayContacts(ContactInfo);
  137.   Writeln;
  138.   DisplayFirst(ContactInfo);
  139.   Writeln;
  140.   DisplayLast(ContactInfo);
  141.   Writeln;
  142.   FindLastName(ContactInfo, 'Wagner');
  143.  
  144.   { Dispose of the collection and all the objects in it }
  145.   Dispose(ContactInfo, Done);
  146. end.